home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / sdimage.com / EXPBOX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-14  |  5.7 KB  |  146 lines
  1.  
  2. { *********************************************************************** }
  3. {                                                                         }
  4. {  ExpBox V1.03 explodes a Box on the display using BGI routines.         }
  5. {  You define the final box area, how many steps in the explosion,        }
  6. {  the speed at which the explosion occurs, and where the explosion       }
  7. {  is to start at. You also define the color and pattern of the           }
  8. {  exploding box. You can optionally specifiy a rectangle to follow       }
  9. {  the exploding box to provide more action. The color of the rectangle   }
  10. {  can also be defined.                                                   }
  11. {    Uses the TP graph unit and the CRT unit (only uses the Delay         }
  12. {  function from the CRT unit). If you don't use the CRT unit, then you   }
  13. {  might want to consider using the CRTI unit from the Borland TP4        }
  14. {  library on CompuServe which allows you to remove unwanted functions.   }
  15. {                                                                         }
  16. {      Originally written by Michael Day as 20 November 1988              }
  17. {                  Copyright 1988 by Michael Day                          }
  18. {           This release (V1.03) as of 14 February 1989                   }
  19. {            Released to the public domain by author.                     }
  20. {                                                                         }
  21. { *********************************************************************** }
  22. { History:                                                                }
  23. { V1.01 - Original release                                                }
  24. { V1.02 - Removed excess unused code                                      }
  25. { V1.03 - Adjusted number to match new release of SDI                     }
  26.  
  27. unit ExpBox;
  28. interface
  29.  
  30. uses graph,CRT;
  31.  
  32. { *********************************************************************** }
  33. {--                    External access definitions                      --}
  34. { *********************************************************************** }
  35.  
  36. {-------------------------------------------------------------------------}
  37. {Explodes a box on the screen}
  38. {x1,y1,x2,y2=final box size, Step=explosion steps, }
  39. {Speed=delay in ms between explosions, Style=how to explode}
  40. {Color=box color, Pattern=background pattern, }
  41. {RColor=rectangle color (if used) }
  42.  
  43. procedure ExplodeBox(x1,y1,x2,y2:integer;
  44.                      Speed,Step,Style:word;
  45.                      Color,Pattern,RColor:byte);
  46.  
  47.  
  48. { *********************************************************************** }
  49.  
  50. implementation
  51.  
  52.  
  53. procedure ExpRect(x1,y1,x2,y2:integer; Style:word);
  54. var i,Rc,rx,ry,ix,iy:integer;
  55. begin
  56.    bar(X1, Y1, X2, Y2);
  57.    Rc := (style shr 5) and 7;
  58.    if Rc > 0 then
  59.    begin
  60.      ix := ((x2-x1)shr 1)shr rc;
  61.      iy := ((y2-y1)shr 1)shr rc;
  62.      for i := Rc downto 1 do
  63.      begin
  64.        rx := ((x2-x1)shr(i))-ix;
  65.        ry := ((y2-y1)shr(i))-iy;
  66.        rectangle(succ(X1+rx), succ(Y1+ry), pred(X2-rx), pred(Y2-ry) );
  67.      end;
  68.    end;
  69. end;
  70.  
  71. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  72. {                         misc special effects                            }
  73. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  74.  
  75. {-------------------------------------------------------------------------}
  76. {Explodes a box on the screen}
  77.  
  78. {Styles: 0=explode from center, 1=explode from top, 2=explode from bottom,}
  79. {3=explode from left, 4=explode from right, 5=explode from top left corner,}
  80. {6=explode bot left corner, 7=explode top right corner, }
  81. {8=explode from bottom right corner. 9 and Above = no explode.}
  82. {if Style bits 5,6,7 are set, then rectangles will be drawn while exploding.}
  83. {a Step value of 0 or 1 will not cause an explode, the value must be larger}
  84. {than 1 to get an explode to happen. Speed sets the delay in ms between}
  85. {explode steps. Color and Pattern set the exploding box color and pattern.}
  86. {RColor sets the rectangle color (when used). If Style bit 4 is on, then }
  87. {sound effects will also be added.}
  88.  
  89. procedure ExplodeBox(x1,y1,x2,y2:integer;
  90.                      Speed,Step,Style:word;
  91.                      Color,Pattern,RColor:byte);
  92. var si,i,Sx,Sy : integer;
  93. begin
  94.    if Step > 0 then
  95.    begin
  96.      if (Style and $10) = $10 then NoSound;
  97.      Sx := (x2-x1) div Step;
  98.      Sy := (y2-y1) div Step;
  99.      SetFillStyle(Pattern,Color);
  100.      setcolor(RColor);
  101.      for i := pred(Step) downto 1 do
  102.      begin
  103.        case (Style and $f) of
  104.          {center explode}
  105.          0: ExpRect(x1+((Sx*i)shr 1), y1+((Sy*i)shr 1),
  106.                     x2-((Sx*i)shr 1), y2-((Sy*i)shr 1), Style);
  107.  
  108.          {top explode}
  109.          1: ExpRect(x1, y1, x2, y2-(Sy*i), Style);
  110.  
  111.          {bot explode}
  112.          2: ExpRect(x1, y1+(Sy*i), x2, y2, Style);
  113.  
  114.          {left explode}
  115.          3: ExpRect(x1, y1, x2-(Sx*i), y2, Style);
  116.  
  117.          {right explode}
  118.          4: ExpRect(x1+(Sx*i), y1, x2, y2, Style);
  119.  
  120.          {top left explode}
  121.          5: ExpRect(x1, y1, x2-(Sx*i), y2-(Sy*i), Style);
  122.  
  123.          {bot left explode}
  124.          6: ExpRect(x1, y1+(Sy*i), x2-(Sx*i), y2, Style);
  125.  
  126.          {top right explode}
  127.          7: ExpRect(x1+(Sx*i), y1, x2, y2-(Sy*i), Style);
  128.  
  129.          {bot right explode}
  130.          8: ExpRect(x1+(Sx*i), y1+(Sy*i), x2, y2, Style);
  131.  
  132.        end; {case}
  133.  
  134.        if (Style and $10) = $10 then Sound(i shl 8);
  135.        if (Style and $f) < 9 then delay(Speed);
  136.      end;
  137.      bar(x1,y1,x2,y2);  {draw final box}
  138.      if (Style and $10) = $10 then NoSound; {turn the sound off if was on}
  139.    end;
  140. end;
  141.  
  142.  
  143. { *********************************************************************** }
  144.  
  145. end.
  146.